(define-derived-mode sql-ms-browse-mode sql-ms
  "Helps with finding details in procs and triggers. Derived from Sql-mode"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq sql-ms-browse-minor-mode-map (make-sparse-keymap));keymap, so certain key chords work to our advantage

(add-hook 'sql-ms-assist-ptv-minor-mode-hook 'smapmm-set-search-name)

(global-set-key '[M-left] 'back-button);still not totally working or useful
(global-set-key '[M-right] 'visit-proc);works nicely
(global-set-key "\M-\r" 'sp_findstring);works nicely

(setq *buffer-list* '())

(defun run-query (qstr)
  "runs the query against the sql buffer"
    (sql-send-string qstr)
    (sql-send-string "go"))

(defun kill-blank-lines ()
  "some queries come back with alternating lines blank"
    (interactive)
    (end-of-buffer)
    (while (re-search-backward "^[ ]+$" nil t)
      (beginning-of-line)
      (kill-line)))

(defun visit-proc ()
  "go to the proc bufffer"
  (interactive)
  (setf *current-symbol* (thing-at-point 'symbol))
  (setf ob-type (object-type *current-symbol*))
  (setf prepend-string "")
  (cond ((string-equal ob-type "P")
	 (setf prepend-string "sp_helptext"))
	((string-equal ob-type "FN")
	 (setf prepend-string "sp_helptext"))
	((string-equal ob-type "TR")
	 (setf prepend-string "sp_helptext"))
	(t
	 (setf prepend-string "sp_help")))
  (when (not (get-buffer (concat prepend-string "-" *current-symbol*)))
    (create-buffer-from-proc *current-symbol* prepend-string))
  (switch-to-buffer (concat prepend-string "-" *current-symbol*))
  (beginning-of-buffer)
  (delete-other-windows)
  (push (concat prepend-string "-" *current-symbol*) *buffer-list*))

(defun sp_findstring ()
  "standard sp_findstring call - still needs a bit of work"
  (interactive)
  (setf *current-symbol* (thing-at-point 'symbol))
  (when (not (get-buffer (concat "sp_findstring-" *current-symbol*)))
    (create-buffer-from-proc (concat "'" *current-symbol* "'") "sp_findstring"))
  (switch-to-buffer (concat "sp_findstring-" *current-symbol*))
  (beginning-of-buffer)
  (delete-other-windows)
  (push (concat "sp_findstring-" *current-symbol*) *buffer-list*))


(defun create-buffer-from-proc (proc-name sp_command)
  ;(message (concat "++++>" proc-name))
  (when (not (get-buffer (concat sp_command "-" *current-symbol*)))
  (set-buffer "*SQL*")
  (delete-region (point-min) (point-max))
  (run-query (concat sp_command " " proc-name))
  (delta-wait 30 (selected-window) (next-window))
  (set-buffer "*SQL*")
  (end-of-buffer)
  (kill-blank-lines)
  (copy-region-as-kill (point-min) (point-max))
  (get-buffer-create (concat sp_command "-" *current-symbol*))
  (set-buffer (concat sp_command "-" *current-symbol*))
  (insert (pop kill-ring)))
  (switch-to-buffer (concat sp_command "-" *current-symbol*)))

(defmacro delta-wait (timeout selected-window next-window)
  "Used for waiting for the SQL buffer to be populated"
  `(let* ((safetylimit (make-symbol "sl")) (safetylimit ,timeout)
	  (this-window (make-symbol "tw")) (this-window ,selected-window)
	  (window-below (make-symbol "wb")) (window-below ,next-window)
	  (base-point (make-symbol "bp"))  (base-point (max-point window-below this-window))
	  (REFERENCE-POINT (make-symbol "rp")) (REFERENCE-POINT base-point)
	  (point-now (make-symbol "pn")) (point-now 0)
	  (safetycount (make-symbol "sc")) (safetycount 0)
	  (iterator (make-symbol "i")) (iterator 0)
	  (loading (make-symbol "l")) (loading 1))
     (while (< safetycount safetylimit)
       (setf point-now (max-point window-below this-window))
       (if (and (eq point-now REFERENCE-POINT) (> REFERENCE-POINT base-point))
	   (setf safetycount safetylimit))
       (setf REFERENCE-POINT point-now)
       (message "PROCESSING")
       (sleep-for 1)
       (incf safetycount))))

(defun max-point (window-below this-window)
    (select-window window-below)
    (setf mymaxpoint (point-max))
    (select-window this-window)
    mymaxpoint)

(defun clear-other-window (other-window this-window)
    (select-window other-window)
    (delete-region (point-min) (point-max))
    (select-window this-window))

(defun back-button ()
  (interactive)
  (switch-to-buffer (pop *buffer-list*)))

(defun object-type (object-name)
  (run-query (concat "select xtype from sysobjects where name ='" object-name  "'"))
  (delta-wait 30 (selected-window) (next-window))
  (set-buffer "*SQL*")
					; (end-of-buffer)
					;(newline)
  (sql-ms-munge)
  (car(first (getf *res* :tuples))))


;;;;we're trying to parse text returned from queries
(defun sql-ms-query-parse-find-dashes ()
  "Used to find the first dashed line in a buffer from point UPWARDS.
  The dashed line separates the column headings and values
  in the string output of a query"
					;(interactive)
  (re-search-backward "^ [-]+[ ]*"))


(defun sql-ms-query-parse-get-column-start-end()
  "For a given position, tries to find the starting and
   ending columns(buffer positions) of a given column (sql results),
   using the dashed separator in sql text output."
;  (interactive)
  (search-forward "-")
  (backward-char 1)
  (setf colstart (current-column))
  (search-forward " ")
  (if (eql (current-column) 1) (backward-char 2) (backward-char 1))
  (setf colend (- (current-column) 0))
  (list colstart colend))


(defun sql-ms-query-parse-get-columns-and-line()
  "Used to get the line position of the dashed line,
   and the start and end columns (buffer) of the columns (sql query)"
  ;(end-of-buffer);bit doubtful about whether we should do this
  (re-search-backward ".+")
  (setf end-line (line-number-at-pos))
  (sql-ms-query-parse-find-dashes)
  (end-of-line)
  (setf line-end (- (current-column) 1)) 
  (beginning-of-line)
  (setf columns '())
  (while (< (current-column) line-end)
    (progn
      (push (sql-ms-query-parse-get-column-start-end) columns)))
  (list :columns (reverse columns) :line (+ (line-number-at-pos) 1) :end-line end-line))

(setf *res* nil)


(defun sql-ms-query-parse-get-vals (line cols)
  (goto-line line)
  (setf values '())
  (setf colcount 0)
  (while (> (length cols) 0)
    (progn
      (beginning-of-line)
      (setf se (pop cols))
      (forward-char (first se))
      (setf mystart (point))
      (beginning-of-line)
      (forward-char (second se))
      (setf myend (point))
      (setf whole-match (buffer-substring-no-properties mystart myend))
      (setf whole-match (sql-ms-query-parse-chomp whole-match))
      (message (concat "->" whole-match))
					;(push colcount values)
      (push whole-match values)
      (incf colcount)))
  (reverse values))



(defun sql-ms-query-parse-chomp (str)
  "This function has been stolen off the web
I think the right person should get credit for it
but I can't for the LIFE of me remember where I found it..."
  (let ((s (if (symbolp str)(symbol-name str) str)))
    (save-excursion
      (while (and
	      (not (null (string-match "^\\( \\|\f\\|\t\\|\n\\)" s)))
	      (> (length s) (string-match "^\\( \\|\f\\|\t\\|\n\\)" s)))
	(setq s (replace-match "" t nil s)))
      (while (and
	      (not (null (string-match "\\( \\|\f\\|\t\\|\n\\)$" s)))
	      (> (length s) (string-match "\\( \\|\f\\|\t\\|\n\\)$" s)))
	(setq s (replace-match "" t nil s))))
    s))

(defun sql-ms-query-parse-listtohash (list)
  "converts the list containing integers and string values to
a hash table, so you can refer to columns(SQL QUERY) by name
instead of index"
  (setf h (make-hash-table :test 'equal))
  (while (> (length list) 0)
    (puthash (pop list) (pop list) h))
  h)

  (defun smapmm-run-query (qstr)
    (sql-send-string qstr)
    (sql-send-string "go"))


  (defun smapmm-clear-other-window (other-window this-window)
    (select-window other-window)
    (delete-region (point-min) (point-max))
    (select-window this-window))


;get everything, so we can start doing all sorts of funky... queries
(defun sql-ms-query-results-of-query-get()
"Wrapper around a couple of functions. Call this in a *SQL* type buffer, and you end up getting a list back with the column headings and values of each tuple."
  (setf columns-and-line (sql-ms-query-parse-get-columns-and-line))
  (setf headings (sql-ms-query-parse-get-vals (- (getf columns-and-line :line) 2) (getf columns-and-line :columns)))
  (setf resultset '())
  (setf inc (- (getf columns-and-line :end-line) (- (getf columns-and-line :line) 1)))
  (while (>= (decf inc) 0)
    (message (concat "INC->:" (number-to-string inc)))
    (push (sql-ms-query-parse-get-vals (+ (getf columns-and-line :line) inc) (getf columns-and-line :columns)) resultset)
        ;(push inc resultset)
    )
  ;(setf first-line (get-vals (+ (getf columns-and-line :line) 1) (getf columns-and-line :columns)))
  (list :headings headings :tuples resultset))


(defun sql-ms-munge()
  "Just a wrapper around sql-ms-query-results-of-query-get so you don't have to call that great big long name"
;  (interactive)
  (setf *res* (sql-ms-query-results-of-query-get)))

(defun tabify-list (lin)
  (mapcar #'(lambda (x) (insert (concat x "\t")) )lin)
  (newline))

(defun spit-table (table)
  (mapcar #'(lambda (x) (tabify-list x)) table))

(defun convertTextToTabs()
;  (interactive)
  (progn
    (sql-ms-munge)
    (end-of-buffer)
    (insert "*** CONVERTED TAB SEPARATED ITEMS BELOW ***\n")
    (tabify-list (getf *res* :headings))
    (spit-table (getf *res* :tuples))))

;;;we treat the format we receive from sql-ms as the default. Other supplied formats must be converted.
(setf columns '())

(setf conversion-data '())
(defun rpt2sql-ms ()
 ; (interactive)
  (setf end-point (line-number-at-pos));the last line of the change.
  (re-search-backward "^[-]+[ ]*")
  (setf start-point (line-number-at-pos))
  (previous-line)
					;(end-of-line)
					;(insert " ")
  (beginning-of-line)
  (insert " ")
  (next-line)
  (end-of-line)
  (insert " ")
  (beginning-of-line)
  (insert " ")

  (setf columns '())

  (end-of-line)
  (setf line-end (- (current-column) 1)) 
  (beginning-of-line)


  ;something odd with the position of the end-point
  (while (and (< (current-column) line-end) (< (line-number-at-pos) end-point))
    (progn
      (message (concat "->" (number-to-string (line-number-at-pos)) ":"  (number-to-string (current-column))))
      (push (sql-ms-query-parse-get-column-start-end) columns)))
					;(reverse columns)
  (setf end-column (cdr (pop columns)))
  ;columns
  
  ;okay, so we know what the target column is.
  (goto-line (+ start-point 0))
  (while (> (- end-point (line-number-at-pos)) 0)
    (message (concat "end-point->:" (number-to-string end-point)))
    (next-line)
    (beginning-of-line)
    (insert " ")
    (end-of-line)
    (message (concat "end-column->:" (number-to-string (car end-column))))
    (pad-to-column (car end-column))
    )
  )

(defun pad-to-column (target-column &optional pad-character )
;  (interactive)
  (setf target-column (- target-column (current-column)))
  (if (eq nil pad-character)
      (setf pad-character " "))
  (while (<= 0 (decf target-column))
    (insert pad-character)))

  (defun rpt2tabs ()
    (interactive)
    (rpt2sql-ms)
    (convertTextToTabs))
    
    






;appolicypopulate
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (select-window (previous-window))
  (sql-mode))



